home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #002 (19xx)(Amiga User Group Deutschland e.V.).zip / Franz PD Disk #002 (19xx)(Amiga User Group Deutschland e.V.).adf / Trails / TrailsInfo.mod < prev    next >
Text File  |  1986-10-22  |  6KB  |  186 lines
  1. IMPLEMENTATION MODULE TrailsInfo;
  2.  
  3. (*
  4.     This module displays a requester with some info
  5.     about Trails.
  6.     
  7.     Created: 6/11/86 by Richie Bielak
  8.     
  9.     Modified:
  10.  
  11.     CopyRight (c) 1986, by Richie Bielak
  12.     
  13.     This program may be freely distributed. But please leave
  14.     my name in. Thanks... Richie.
  15.  
  16. *)
  17.  
  18. FROM Intuition    IMPORT WindowPtr, IDCMPFlagsSet, IntuitionText, Requester,
  19.                          RequesterFlagsSet, Gadget, GadgetFlagsSet,
  20.              ActivationFlagsSet, ActivationFlags,
  21.              Border;
  22. FROM Requesters   IMPORT InitRequester, Request;
  23. FROM SYSTEM       IMPORT ADR, BYTE, ADDRESS;
  24. FROM GraphicsLibrary IMPORT Jam2, Jam1, DrawingModeSet;
  25.  
  26.  
  27. VAR
  28.   NULL : ADDRESS;
  29.   InfoRequest : Requester;
  30.  
  31. (* ++++++++++++++++++++++++++++++++++++ *)
  32. PROCEDURE ShowTrailsInfo (wp : WindowPtr);
  33.   VAR succ : BOOLEAN;
  34.   BEGIN
  35.     succ := Request (InfoRequest, wp^)
  36.   END ShowTrailsInfo;
  37.  
  38. (* ++++ GADGET related variables ++++++ *)
  39. CONST
  40.   InfoGadWidth = 70;
  41.   InfoGadHeight = 10;
  42.   BOOLGADGET = 1H;
  43.   REQGADGET = 1000H;
  44. VAR
  45.   InfoGadText    : IntuitionText;
  46.   InfoGad        : Gadget;
  47.   InfoGadTextStr : ARRAY [0..20] OF CHAR;
  48.   InfoGadBorder  : Border;
  49.   InfoGadPairs   : ARRAY [1..10] OF INTEGER;
  50.  
  51. (* ++++++++++++++++++++++++++++++++++++ *)
  52. PROCEDURE SetUpGadget ();
  53.   BEGIN
  54.     InfoGadTextStr := "Continue";
  55.  
  56.     (* Coordinates for border of the gadget box *)
  57.     InfoGadPairs [1] := 0;    InfoGadPairs [2] := 0;    
  58.     InfoGadPairs [3] := InfoGadWidth+1;    InfoGadPairs [4] := 0;
  59.     InfoGadPairs [5] := InfoGadWidth+1;
  60.     InfoGadPairs [6] := InfoGadHeight+1;
  61.     InfoGadPairs [7] := 0;    InfoGadPairs [8] := InfoGadHeight+1;
  62.     InfoGadPairs [9] := 0;    InfoGadPairs [10] := 0;    
  63.  
  64.     WITH InfoGadBorder DO
  65.       LeftEdge := -1; TopEdge := -1;
  66.       FrontPen := BYTE (3); BackPen := BYTE (0);
  67.       DrawMode := BYTE (Jam1); Count := BYTE (5);
  68.       XY := ADR (InfoGadPairs); NextBorder := NULL;
  69.     END;
  70.  
  71.     WITH InfoGadText DO
  72.       FrontPen := BYTE (2); BackPen := BYTE (1);
  73.       DrawMode := BYTE (DrawingModeSet {Jam2});
  74.       LeftEdge := 1; TopEdge := 1;
  75.       ITextFont := NULL; NextText := NULL;
  76.       IText := ADR (InfoGadTextStr);
  77.     END;
  78.  
  79.     WITH InfoGad DO
  80.       NextGadget := NULL;
  81.       LeftEdge := (InfoReqWidth DIV 2) - (InfoGadWidth DIV 2);
  82.       TopEdge := InfoReqHeight - (InfoGadHeight + 5);
  83.       Width := InfoGadWidth; Height := InfoGadHeight;
  84.       Flags := GadgetFlagsSet {};
  85.       Activation := ActivationFlagsSet {EndGadget, RelVerify};
  86.       GadgetType := BOOLGADGET + REQGADGET;
  87.       GadgetRender := ADR (InfoGadBorder);
  88.       SelectRender := NULL;
  89.       GadgetText := ADR (InfoGadText);
  90.       MutualExclude := 0;
  91.       SpecialInfo := NULL; GadgetID := 0; UserData := NULL
  92.     END;
  93.   END SetUpGadget;
  94.  
  95. (* +++++++ These variables are needed for the requester's stuff +++ *)
  96. CONST
  97.   InfoReqWidth = 300;
  98.   InfoReqHeight = 100;
  99.  
  100. VAR
  101.   InfoReqBorder : Border;
  102.   InfoReqPairs  : ARRAY [1..10] OF INTEGER;
  103.   InfoReqText   : ARRAY [0..5] OF IntuitionText;
  104.  
  105.   
  106. (* ++++++++++++++++++++++++++++++++++++ *)
  107. PROCEDURE SetUpRequester ();
  108.   BEGIN
  109.     (* Set up the border stuff *)
  110.     (* Coordinates for border of the gadget box *)
  111.     InfoReqPairs [1] := 0;    InfoReqPairs [2] := 0;    
  112.     InfoReqPairs [3] := InfoReqWidth-3;    InfoReqPairs [4] := 0;
  113.     InfoReqPairs [5] := InfoReqWidth-3;
  114.     InfoReqPairs [6] := InfoReqHeight-3;
  115.     InfoReqPairs [7] := 0;    InfoReqPairs [8] := InfoReqHeight-3;
  116.     InfoReqPairs [9] := 0;    InfoReqPairs [10] := 0;    
  117.  
  118.     WITH InfoReqBorder DO
  119.       LeftEdge := 1; TopEdge := 1;
  120.       FrontPen := BYTE (3); BackPen := BYTE (0);
  121.       DrawMode := BYTE (Jam1); Count := BYTE (5);
  122.       XY := ADR (InfoReqPairs); NextBorder := NULL;
  123.     END;
  124.  
  125.     (* Set up the requester *)
  126.     InitRequester (InfoRequest);
  127.  
  128.     WITH InfoRequest DO
  129.       LeftEdge := 20; TopEdge := 30;
  130.       Width := InfoReqWidth; Height := InfoReqHeight;
  131.       ReqGadget := ADR (InfoGad);
  132.       ReqText := ADR (InfoReqText);
  133.       ReqBorder := ADR (InfoReqBorder);
  134.       BackFill := BYTE (1);
  135.     END;
  136.  
  137.   END SetUpRequester;
  138.  
  139. (* ++++++++++++++++++++++++++++++++++++ *)
  140. PROCEDURE SetUpRequesterText ();
  141.  
  142.   (* ++++++++++++++++++++++++++++ *)
  143.   PROCEDURE InitIText (VAR itext : IntuitionText;
  144.                        L, T : CARDINAL;
  145.                Next : ADDRESS;
  146.                VAR text : ARRAY OF CHAR);
  147.     BEGIN
  148.       WITH itext DO
  149.         FrontPen := BYTE (2); BackPen := BYTE (1);
  150.         DrawMode := BYTE (DrawingModeSet {Jam2});
  151.         LeftEdge := L; TopEdge := T;
  152.         ITextFont := NULL; NextText := Next;
  153.         IText := ADR (text);
  154.       END;
  155.     END InitIText;
  156.  
  157.   BEGIN
  158.     InitIText (InfoReqText[0], 5, 10, ADR (InfoReqText[1]),
  159.                " This program was written using ");
  160.     InitIText (InfoReqText[1], 5, 20, ADR (InfoReqText[2]),
  161.                "        TDI/Modula-2.");
  162.     InitIText (InfoReqText[2], 5, 30, ADR (InfoReqText[3]),
  163.                "-----------------------------------");
  164.     InitIText (InfoReqText[3], 5, 40, ADR (InfoReqText[4]),
  165.                "Copyright (c) 1986 - Richie Bielak");
  166.     InitIText (InfoReqText[4], 5, 60, ADR (InfoReqText[5]),
  167.                "This program can be freely copied, ");
  168.     InitIText (InfoReqText[5], 5, 70, NULL,
  169.                "but please leave my name in. Thanks.");
  170.   END SetUpRequesterText;
  171.  
  172. (* +++++++++++++++++++++++++++++ *)
  173. PROCEDURE InitTrailsInfo ();
  174.   BEGIN
  175.     (* Initialize the Gadget that goes with the requester *)
  176.     SetUpGadget ();
  177.     (* Initialize text for the requester *)
  178.     SetUpRequesterText ();
  179.     (* Initialize the requester *)
  180.     SetUpRequester ();
  181.   END InitTrailsInfo;
  182.  
  183. BEGIN
  184.   NULL := ADDRESS (0);
  185. END TrailsInfo.
  186.